home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 6 / The Arsenal Files 6 (Arsenal Computer).ISO / prg_basi / n_b-v200.zip / NB03 / UNT / STR-MATH.UNT < prev    next >
Text File  |  1996-03-11  |  25KB  |  436 lines
  1. $if 0
  2.     ┌──────────────────────────╖                        PowerBASIC v3.20
  3.  ┌──┤          DASoft          ╟──────────────────────┬──────────────────╖
  4.  │  ├──────────────────────────╢    Copyright 1995    │ DATE: 1996-01-01 ╟─╖
  5.  │  │ FILE NAME   STR-MATH.UNT ║          by          ╘════════════════─ ║ ║
  6.  │  │ LIBRARY     DAS-NB03.PBL ║  Don Schullian, Jr.                     ║ ║
  7.  │  ╘══════════════════════════╝                                         ║ ║
  8.  │ A license is hereby granted to the holder to use this source code in  ║ ║
  9.  │ any program, commercial or otherwise,  without receiving the express  ║ ║
  10.  │ permission of the copyright holder and without paying any royalties,  ║ ║
  11.  │ as long as this code is not distributed in any compilable format.     ║ ║
  12.  │  IE: source code files, PowerBASIC Unit files, and printed listings   ║ ║
  13.  ╘═╤═════════════════════════════════════════════════════════════════════╝ ║
  14.    │                .....................................                  ║
  15.    ╘═══════════════════════════════════════════════════════════════════════╝
  16. $endif
  17.  
  18. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  19. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  20. $if 1
  21.   $CODE SEG "DAS_NB03"
  22.   $EVENT               OFF
  23.   $ERROR     ALL       OFF
  24.   $OPTIMIZE  SPEED
  25.   $OPTION    GOSUB     OFF
  26.   $OPTION    CNTLBREAK OFF
  27.   $OPTION    SIGNED    OFF
  28.   $DEBUG     MAP       OFF
  29.   $DEBUG     PATH      OFF
  30.   $DEBUG     UNIT      OFF
  31.   $COMPILE   UNIT
  32. $endif
  33.  
  34. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  35. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  36. ' PURPOSE: provide extended arithmetic functions for strings
  37. '  PARAMS: N1$    N1$ + N2$  or  N1$ - N2$  or N1$ * N2$ or N1$ / N2$
  38. '          N2$    incoming numbers may be signed or not and pbvUsingChrs
  39. '                 is used to determine which (if any) decimal point is used
  40. '          Decs%  for DIVIDE only - the number of places past the decimal
  41. '                                   that are to be used in the answer
  42. ' RETURNS: the answer
  43. '          all values other than ZERO are signed with either + or -
  44. '          if the return value is ZERO then only a single "0" is returned
  45. '    NOTE: division by ZERO returns ZERO and not an error
  46. '    NOTE: N1$ * ".5" is faster than N1$ / "2"
  47. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  48. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  49.  
  50. %F   =  0  ' first pointer
  51. %L   =  1  ' last
  52. %W   =  2  ' working
  53. %Pos = 43  ' plus sign
  54. %Neg = 45  ' minus sign
  55.  
  56. DIM sN(2)      AS SHARED STRING    ' working strings
  57. DIM sD(2,2)    AS SHARED INTEGER   ' sD%(0,X%)    = places before decimal
  58.                                    ' sD%(1,X%)    = places past the decimal
  59.                                    ' sD%(2,X%)    = sign
  60. DIM N_ptr(2,2) AS SHARED BYTE PTR  ' N_ptr(%F,X%) = first digit
  61.                                    ' N_ptr(%L,X%) = last digit
  62.                                    ' N_ptr(%W,X%) = working digit
  63. SHARED sD$, sA$, sZ$, sP$          ' dec$, ascii$, chr$(0), "."
  64.  
  65. ' ──────────────────────────────────────────────────────────────────────────
  66.  
  67. FUNCTION fDIVnbr$( SEG N1$, SEG N2$, BYVAL Decs% ) LOCAL PUBLIC
  68.   LOCAL C%, L%, P%, X%
  69.  
  70.   Format_NBRs N1$, N2$, ( 4 + Decs% )              ' get everybody ready
  71.   IF N_ptr(%F,0) = 0 THEN                          ' N1=0 or N2=0
  72.     FUNCTION = "0"                                 '  function = 0
  73.     EXIT FUNCTION                                  '  RETURN
  74.   END IF                                           '
  75.                                                    '
  76.   L% = LEN( sN$(2) )                               ' length of divisor
  77.   IF sN$(1) < sN$(2) THEN INCR N_ptr(%F,0)         ' if number > divisor
  78.                                                    '
  79.   WHILE N_ptr(%F,0) =< N_ptr(%L,0)                 ' while still calculating
  80.     P% = L%                                        ' P% = # of digits to use
  81.     IF sN$(1) < sN$(2) THEN INCR P%                ' number is > divisor
  82.     IF @N_ptr(%F,0) = 46 THEN INCR N_ptr(%F,0)     ' skip the decimal point
  83.     WHILE ( sN$(1) => sN$(2) ) OR ( P% > L% )      ' while N° > divisor
  84.       N_ptr(%W,1) = N_ptr(%F,1) + P%               ' working pointers
  85.       N_ptr(%W,2) = N_ptr(%L,2) + 1                '
  86.       FOR X% = L% TO 1 STEP -1                     ' do subtraction
  87.         DECR N_ptr(%W,1)                           '  decr pointers
  88.         DECR N_ptr(%W,2)                           '
  89.         IF ( C% > 0 ) THEN                         '  if carrying
  90.           IF @N_ptr(%W,1) > 0 THEN                 '   if digit > 0
  91.               DECR @N_ptr(%W,1)                    '    subtract carry amt
  92.               C% = 0                               '    clear carry
  93.             ELSE                                   '   else
  94.               @N_ptr(%W,1) = 9                     '    carring a 9
  95.           END IF                                   '
  96.         END IF                                     '
  97.         IF @N_ptr(%W,2) > @N_ptr(%W,1) THEN        '  if digit 1 > digit 2
  98.           C% = 10                                  '   carry 10
  99.           INCR @N_ptr(%W,1), C%                    '   bump digit 1
  100.         END IF                                     '
  101.         DECR @N_ptr(%W,1), @N_ptr(%W,2)            '  subtract d2 from d1
  102.       NEXT                                         ' NEXT digit left
  103.       IF C% > 0 THEN                               ' if still carrying
  104.         DECR N_ptr(%W,1)                           '  prev digit
  105.         DECR @N_ptr(%W,1)                          '  decr ditit
  106.         C% = 0                                     '  clear carry
  107.       END IF                                       '
  108.       IF (P% > L%) AND (ASCII( sN$(1) ) = 0) THEN  ' check if right digit
  109.         P% = L%                                    ' needs to fall off
  110.         MID$(sN$(1),1) = MID$( sN$(1),2) + sZ$     ' shift left
  111.       END IF                                       '
  112.       INCR @N_ptr(%F,0)                            ' next digit in answer
  113.     WEND                                           '
  114.                                                    '
  115.     N_ptr(%W,1) = N_ptr(%L,1)                      ' check to see if number
  116.     FOR X% = LEN( sN$(1) ) TO 1 STEP -1            ' is now all ZERO's or
  117.       IF @N_ptr(%W,1) > 0 THEN EXIT FOR            ' not
  118.       DECR N_ptr(%W,1)                             '
  119.     NEXT                                           '
  120.     IF X% = 0 THEN EXIT LOOP                       ' Nope! - all done!
  121.                                                    '
  122.     WHILE ASCII( sN$(1) ) = 0                      ' if leading char ZERO
  123.       MID$( sN$(1), 1 ) = MID$(sN$(1),2) + sZ$     ' shift left
  124.       IF sN$(1) < sN$(2) THEN                      ' if number < divisor
  125.         INCR N_ptr(%F,0)                           '  skip digit in answer
  126.         IF @N_ptr(%F,0)=46 THEN INCR N_ptr(%F,0)   '  skip decimal point
  127.       END IF                                       '
  128.     WEND                                           '
  129.     INCR N_ptr(%F,0)                               ' next digit in answer
  130.   WEND                                             '
  131.                                                    '
  132.   @N_ptr(%L,0) = 0                                 '
  133.                                                    '
  134.   FUNCTION = fFormat_NBR$                          ' clean-up & bail out!
  135.  
  136. END FUNCTION
  137.  
  138. ' ──────────────────────────────────────────────────────────────────────────
  139.  
  140. FUNCTION fMULnbr$( SEG N1$, SEG N2$ ) LOCAL PUBLIC
  141.   LOCAL C%, D%, N1%, N2%, X%, Y%
  142.  
  143.   Format_NBRs N1$, N2$, 3                          ' get everybody ready
  144.   IF N_ptr(%F,0) = 0 THEN                          ' N1=0 or N2=0
  145.     FUNCTION = "0"                                 '  function = 0
  146.     EXIT FUNCTION                                  '  RETURN
  147.   END IF                                           '
  148.   N1% = LEN( sN$(1) )                              ' loop parameters
  149.   N2% = LEN( sN$(2) )                              '
  150.   FOR X% = N1% TO 1 STEP -1                        ' once for each dig in 1
  151.     IF @N_ptr(%L,1) = 0 THEN GOTO Mul_nbr          '  digit = 0 skip it >> ┐
  152.     N_ptr(%W,0) = N_ptr(%L,0)                      '  end digit of working │
  153.     N_ptr(%W,2) = N_ptr(%L,2)                      '  end digit of 2       │
  154.     FOR Y% = N2% TO 1 STEP -1                      '  each dig in 2        │
  155.       INCR C%, ( @N_ptr(%L,1) * @N_ptr(%W,2) )     '   inc carry, dig*dig  │
  156.       INCR C%, @N_ptr(%W,0)                        '   inc carry, work dig │
  157.       @N_ptr(%W,0) = ( C% MOD 10 )                 '   put right-most dig  │
  158.       C% = ( C% \ 10 )                             '   divide carry        │
  159.       DECR N_ptr(%W,0)                             '   back-up digits      │
  160.       DECR N_ptr(%W,2)                             '                       │
  161.       IF @N_ptr(%W,0) = 46 THEN DECR N_ptr(%W,0)   '   skip the decimal    │
  162.     NEXT                                           '                       │
  163.     Mul_nbr:                                       ' <<────────────────────┘
  164.     DECR N_ptr(%L,1)                               ' back-up end ptrs 1 & W
  165.     DECR N_ptr(%L,0)                               '
  166.     IF @N_ptr(%L,0) = 46 THEN DECR N_ptr(%L,0)     ' skip decimal point
  167.     IF C% = 0 THEN ITERATE                         ' nothing to carry loop
  168.     INCR @N_ptr(%W,0), C%                          ' put the carry in W
  169.     C% = 0                                         ' clear carry
  170.   NEXT                                             '
  171.                                                    '
  172.   FUNCTION = fFormat_NBR$                          ' clean-up & bail out!
  173.  
  174. END FUNCTION
  175.  
  176. ' ──────────────────────────────────────────────────────────────────────────
  177.  
  178. FUNCTION fSUBnbr$( SEG N1$, SEG N2$ ) LOCAL PUBLIC
  179.  
  180.   Format_NBRs N1$, N2$, 2                          ' set-up the strings
  181.   IF N_ptr(%F,1) = 0 THEN                          ' N1 = 0
  182.       IF N_ptr(%F,2) = 0 THEN                      '  N2 = 0
  183.         FUNCTION = "0"                             '   FUNCTION = 0
  184.         EXIT FUNCTION                              '
  185.       END IF                                       '
  186.       sN$(0) = sN$(2)                              '  N0 = N2
  187.       IF ABS(sD%(2,0)) = %Neg THEN                 '  swap sign
  188.           sD%(2,0) = %Pos                          '
  189.         ELSE                                       '
  190.           sD%(2,0) = %Neg                          '
  191.       END IF                                       '
  192.     ELSEif N_ptr(%F,2) = 0 THEN                    ' N2 = 0
  193.       sN$(0) = sN$(1)                              '  N0 = N1
  194.   END IF                                           '
  195.   IF N_ptr(%F,0) = 0 THEN                          ' IF N1 = 0 OR N2 = 0
  196.       FUNCTION = fFormat_NBR$                      '  format & exit
  197.     ELSEif sD%(2,0) < 0 THEN                       ' unlike signs (add)
  198.       FUNCTION = fADD_nbr$                         '  call add
  199.     ELSE                                           '
  200.       FUNCTION = fSUB_nbr$                         '  do it!
  201.   END IF                                           '
  202.                                                    '
  203. END FUNCTION                                       '
  204.  
  205. ' ──────────────────────────────────────────────────────────────────────────
  206.  
  207. FUNCTION fADDnbr$( SEG N1$, SEG N2$ ) LOCAL PUBLIC
  208.  
  209.   Format_NBRs N1$, N2$, 1                          ' format numbers
  210.   IF N_ptr(%F,1) = 0 THEN                          ' N1 = 0
  211.       IF N_ptr(%F,2) = 0 THEN                      '  N2 = 0
  212.         FUNCTION = "0"                             '   function = 0
  213.         EXIT FUNCTION                              '
  214.       END IF                                       '
  215.       sN$(0) = sN$(2)                              '  N0 = N2
  216.     ELSEif N_ptr(%F,2) = 0 THEN                    ' N2 = 0
  217.       sN$(0) = sN$(1)                              '  N0 = N1
  218.   END IF                                           '
  219.   IF N_ptr(%F,0) = 0 THEN                          ' N1=0 or N2=0
  220.       FUNCTION = fFormat_NBR$                      '  format & exit
  221.     ELSEif ( sD%(2,0) < 0 ) THEN                   ' unlike signs
  222.       FUNCTION = fSUB_nbr$                         '  subtract
  223.     ELSE                                           '
  224.       FUNCTION = fADD_nbr$                         ' do it!
  225.   END IF                                           '
  226.                                                    '
  227. END FUNCTION                                       '
  228.  
  229. ' ==========================================================================
  230.  
  231. FUNCTION fADD_nbr$ () LOCAL PRIVATE
  232.   LOCAL N%, V%, Y%
  233.  
  234.   FOR X% = LEN( sN$(0) ) TO 2 STEP -1
  235.     FOR Y% = 2 TO 0 STEP -1
  236.       DECR N_ptr(%W,Y%)
  237.     NEXT
  238.     IF @N_ptr(%W,0) = 46 THEN ITERATE   ' decimal point
  239.     FOR N% = 2 TO 1 STEP -1
  240.       IF ( N_ptr(%W,N%) =< N_ptr(%L,N%) )  AND _
  241.          ( N_ptr(%W,N%) => N_ptr(%F,N%) ) THEN INCR V%, @N_ptr(%W,N%)
  242.     NEXT
  243.     @N_ptr(%W,0) = ( V% MOD 10 )
  244.     V% = ( V% \ 10 )
  245.   NEXT
  246.   IF V% > 0 THEN
  247.     DECR N_ptr(%W,0)
  248.     @N_ptr(%W,0) = V%
  249.   END IF
  250.   FUNCTION = fFormat_NBR$
  251.  
  252. END FUNCTION
  253.  
  254. ' ──────────────────────────────────────────────────────────────────────────
  255.  
  256. FUNCTION fSUB_nbr$ () LOCAL PRIVATE
  257.   LOCAL V1%, V2%, Y%, P%
  258.   LOCAL N1%, N2%, C%
  259.  
  260.   IF ( sD%(0,2) > sD%(0,1) )   OR _                ' if N2 > N1
  261.      ( sD%(0,2) = sD%(0,1) )  AND _                '  (checking for decimal
  262.      ( sN$(2)   > sN$(1)   ) THEN                  '   point too)
  263.       N1% = 2 : N2% = 1 : sD%(2,0) = %Neg          '   reverse number order
  264.     ELSE                                           ' else
  265.       N1% = 1 : N2% = 2                            '   normal order
  266.   END IF                                           '
  267.                                                    '
  268.   FOR P% = LEN( sN$(0) ) TO 1 STEP -1              '
  269.     FOR Y% = 2 TO 0 STEP -1                        '
  270.       DECR N_ptr(%W,Y%)                            '
  271.     NEXT                                           '
  272.     IF @N_ptr(%W,0) = 46 THEN ITERATE              ' decimal point
  273.     IF N_ptr(%W,N1%) < N_ptr(%F,N1%) THEN          ' past first of N1%
  274.       @N_ptr(%W,0) = C%                            '  put the carry value
  275.       EXIT FOR                                     '  bail out of loop
  276.     END IF                                         '
  277.     V1% = 0 : V2% = 0                              '
  278.     IF N_ptr(%W,N1%) =< N_ptr(%L,N1%) THEN         '
  279.       V1% = @N_ptr(%W,N1%)                         '
  280.       IF ( V1% > 0 ) AND ( C% > 0 ) THEN           '
  281.         DECR V1%                                   '
  282.         C% = 0                                     '
  283.       END IF                                       '
  284.     END IF                                         '
  285.     IF ( N_ptr(%W,N2%) =< N_ptr(%L,N2%) )  AND _   ' if #2 in range
  286.        ( N_ptr(%W,N2%) => N_ptr(%F,N2%) ) THEN     '
  287.       V2% = @N_ptr(%W,N2%)                         '  set value of #
  288.     END IF                                         '
  289.     IF C% > 0 THEN                                 ' carring 9's across
  290.         V1% = C%                                   '
  291.       ELSEif ( V2% > V1% ) THEN                    ' if #2 > #1 then
  292.         C% = 9                                     '   carry 9's
  293.         INCR V1%, 10                               '   bump #1 by 10
  294.     END IF                                         '
  295.     @N_ptr(%W,0) = V1% - V2%                       ' do math & put answer
  296.   NEXT                                             '
  297.                                                    '
  298.   FUNCTION = fFormat_NBR$                          ' format & be gone!
  299.                                                    '
  300. END FUNCTION                                       '
  301.  
  302. ' ──────────────────────────────────────────────────────────────────────────
  303.  
  304. SUB Format_NBRs ( SEG N1$, SEG N2$, BYVAL Which% ) LOCAL PRIVATE
  305.   LOCAL L%, N%, X%
  306.  
  307.   sD$ = CHR$(0,1,2,3,4,5,6,7,8,9,44,46)            ' decimal values
  308.   sA$ = "0123456789" + RIGHT$(pbvUSINGchrs,2)      ' ascii values
  309.   sZ$    = CHR$(00)                                ' local strings
  310.   sP$    = CHR$(46)                                ' decimal point
  311.   sN$(1) = N1$                                     ' get into local vars
  312.   sN$(2) = N2$                                     '
  313.   FOR N% = 2 TO 0 STEP -1                          '
  314.     IF N% > 0 THEN                                 ' one of the numbers
  315.         sN$(N%) = LTRIM$( sN$(N%) )                '  strip off white space
  316.         sN$(N%) = EXTRACT$( sN$(N%), " " )         '  <ditto>
  317.         REPLACE ANY sA$ WITH sD$ IN sN$(N%)        '  convert to decimals
  318.         sD%(2,N%) = ASCII( sN$(N%) )               '  looking for a sign
  319.         IF sD%(2,N%) <> %Neg THEN sD%(2,N%) = %Pos '  not neg so is positive
  320.         sN$(N%) = REMOVE$( sN$(N%), ANY " +-," )   '  strip our signs & junk
  321.         sN$(N%) = LTRIM$( sN$(N%), sZ$ )           '  get rid of leading 0's
  322.         IF INSTR( sN$(N%), sP$ ) > 0 THEN _        '  if a "." in string
  323.           sN$(N%) = RTRIM$( sN$(N%), ANY sP$+sZ$ ) '   strip trailing ".0"s
  324.         L% = LEN( sN$(N%) )                        '  length of what's left
  325.         IF L% = 0  THEN                            '  oops! nothing there
  326.           IF N% = 2 THEN ITERATE                   '   if still 1 to go
  327.           IF N% = 1 THEN                           '   nothing left to do
  328.             sD%(2,0) = sD%(2,2)                    '    set final sign
  329.             EXIT SUB                               '    BYE BYE
  330.           END IF                                   '
  331.         END IF                                     '
  332.         X% = INSTR( sN$(N%), sP$ )                 '  find the decimal point
  333.         IF X% = 0 THEN                             '   these variables
  334.             sD%(0,N%) = L%                         '   carry the number of
  335.           ELSEif X% = 1 THEN                       '   digits before and
  336.             sD%(1,N%) = L% - 1                     '   after the decimal
  337.           ELSE                                     '   there are in the
  338.             sD%(0,N%) = X% - 1                     '   numbers
  339.             sD%(1,N%) = L% - X%                    '
  340.         END IF                                     '
  341.         IF Which% < 3 THEN EXIT IF                 '  if ADD or SUB then exit
  342.         IF X% > 0 THEN                             '  if there is a dec.pnt
  343.           sN$(N%) = REMOVE$( sN$(N%), sP$ )        '   get rid of it
  344.           DECR L%                                  '   adjust the length
  345.         END IF                                     '
  346.         IF Which% = 3 THEN EXIT IF                 '  IF MULT then exit
  347.         IF X% = 1 AND ASCII( sN$(N%) ) = 0 THEN    '   if number = .098 etc
  348.           X% = L%                                  '   hold old length
  349.           sN$(N%) = LTRIM$( sN$(N%), sZ$ )         '   strip leading 0's
  350.           L% = LEN( sN$(N%) )                      '   new length
  351.           IF N% = 1 THEN sD%(0,1) = -( X% - L% )   '   neg places before dec
  352.         END IF                                     '
  353.         IF ( N% = 2 ) THEN EXIT IF                 '  if divisor then exit
  354.         X% = LEN( sN$(2) ) - L% + 1                '  pad N1 to length of N2
  355.         IF X% > 0 THEN _                           '  + 1 so we've got room
  356.                  sN$(1) = sN$(1) + STRING$(X%,0)   '  to work with
  357.       ELSE                                         ' ANSWER STRING
  358.         SELECT CASE Which%                         '
  359.           CASE < 3                                 '  ADD & SUB
  360.             sD%(0,N%) = MAX%(sD%(0,1),sD%(0,2))+1  '   longest whole # +1
  361.             sD%(1,N%) = MAX%(sD%(1,1),sD%(1,2))    '   longest decimal
  362.           CASE   3                                 '  MULT
  363.             sD%(0,N%) = ( sD%(0,1) + sD%(0,2) )    '   length of both wholes
  364.             sD%(1,N%) = ( sD%(1,1) + sD%(1,2) )    '   length of both decs
  365.           CASE ELSE                                '  DIVIDE
  366.             X% = LEN( sN$(2) ) - 1                 '   length of divisor -1
  367.             sD%(0,N%) = sD%(0,1) + sD%(1,2) - X%   '   whole of N1 and decs
  368.             IF sD%(0,N%) < 0 THEN                  '    N2 - len(N2) - 1
  369.               X% = sD%(0,N%) - 1                   '   answer is < 1
  370.               sD%(0,N%) = 0                        '
  371.             END IF                                 '
  372.             sD%(1,N%) = Which% - 4                 '   # of places after dec
  373.         END SELECT                                 '
  374.         L% = sD%(0,N%) + sD%(1,N%) - (sD%(1,N%)>0) ' whole + decs + dec pnt
  375.         IF L% = 0 THEN EXIT SUB                    ' oops! nothing to do
  376.         sN$(0) = STRING$(L%,0)                     ' answer string all 0's
  377.         IF sD%(1,N%) > 0 THEN _                    ' place the decimal pnt
  378.           MID$( sN$(0), sD%(0,N%)+1, 1 ) = sP$     '  if required
  379.     END IF                                         '
  380.     ' ─────────────────────────────────────        '
  381.     N_ptr(%F,N%) = STRPTR32( sN$(N%) )             ' set first pointer
  382.     N_ptr(%L,N%) = N_ptr(%F,N%) + L% - 1           ' set last pointer
  383.   NEXT                                             '
  384.                                                    '
  385.   IF sD%(2,1) <> sD%(2,2) THEN                     ' check for unequal signs
  386.       sD%(2,0) = -sD%(2,1)                         '  return a negative value
  387.     ELSE                                           ' equal signs
  388.       sD%(2,0) = sD%(2,1)                          '  return a positive value
  389.   END IF                                           '
  390.                                                    '
  391.   IF Which% > 2 THEN                               ' MULT & DIVIDE
  392.       IF sD%(2,0) < 0 THEN                         '  if unequal signs
  393.           sD%(2,0) = %Neg                          '   answer is negative
  394.         ELSE                                       '
  395.           sD%(2,0) = %Pos                          '   answer is positive
  396.       END IF                                       '
  397.       IF ( Which% > 3 ) AND _                      '  DIVIDE and only decs.
  398.          (     X% < 0 ) THEN DECR N_ptr(%F,0), X%  '   jump dec pnt & places
  399.     ELSE                                           '
  400.       INCR sD%(1,0)                                ' ADD & SUB
  401.       FOR N% = 2 TO 1 STEP -1                      '  set ending pointers
  402.         IF ( sD%(1, 0) > 1 )  AND _                '  to max of either ptr
  403.            ( sD%(1,N%) = 0 ) THEN DECR sD%(1,N%)   '  so ADD & SUB can loop
  404.         N_ptr(%W,N%) = N_ptr(%L,N%) + _            '  an equal # of times
  405.                           ( sD%(1,0) - sD%(1,N%) ) '  for each number w/out
  406.       NEXT                                         '  fouling the pointers
  407.       N_ptr(%W,0) = N_ptr(%L,0) + 1                '  working pointer
  408.   END IF                                           '
  409.                                                    '
  410. END SUB
  411.  
  412. ' ──────────────────────────────────────────────────────────────────────────
  413.  
  414. FUNCTION fFormat_NBR$ LOCAL PRIVATE
  415.                                                    ' FINAL CLEAN-UP
  416.   sN$(0) = LTRIM$( sN$(0), sZ$ )                   ' strip leading ZERO's
  417.   IF INSTR( sN$(0), sP$ ) > 0 THEN                 ' if a decimal pnt there
  418.     sN$(0) = RTRIM$( sN$(0), sZ$ )                 '  strip trailing ZERO's
  419.     sN$(0) = RTRIM$( sN$(0), sP$ )                 '  strip trailing "."
  420.   END IF                                           '
  421.   IF LEN( sN$(0) ) = 0 THEN                        ' if the answer is ZERO
  422.       FUNCTION = "0"                               '   RETURN plain ZERO
  423.     ELSE                                           '
  424.       REPLACE ANY sD$ WITH sA$ IN sN$(0)           ' switch back to ASCII
  425.       IF ASCII( sN$(0) ) = 46 THEN _               ' if leading decimal pnt
  426.                               sN$(0) = "0"+sN$(0)  ' tag with leading ZERO
  427.       FUNCTION = CHR$( ABS(sD%(2,0)) ) + sN$(0)    ' concant sign & RETURN
  428.   END IF                                           '
  429.   sD$ = ""                                         ' clean-up shared
  430.   sA$ = ""                                         '  strings &
  431.   sZ$ = ""                                         '  arrays
  432.   sP$ = ""                                         '
  433.   ERASE sD%, sN$, N_ptr                            '
  434.  
  435. END FUNCTION
  436.